home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Source code / daSource / dInterp.txt next >
Encoding:
Text File  |  1991-07-04  |  3.3 KB  |  112 lines  |  [TEXT/EDIT]
  1. ; This file is: dInterp.txt  --  interpreter and compiler
  2. ; Mon Apr 25, 1988 15:11:43 macros
  3. ; Wed Apr 27, 1988 12:30:07 v 1.4
  4. ; Thu Jul 04, 1991 05:20:00 add open control key
  5.  
  6. inKey:    ; ( key.data -- )
  7.     BTST    #0,evtMeta(A0)        ; is the command key down?
  8.     BEQ.S    @0
  9.  
  10.     CMPI.B    #'v',1(PS)        ; is the key 'v'?
  11.     BNE.S    @4            ;   if so then
  12.  
  13.     ADDQ    #2,PS            ; drop the ASCII and ...
  14.     JMP    paste-base(BP)        ; ... interpret from clipboard
  15.  
  16.     @4:    CMPI.B    #'o',1(PS)        ; is the key 'o'?
  17.     BNE.S    @0            ;   if not skip ahead.
  18.  
  19.     ADDQ    #2,PS
  20.     JMP    open-base(BP)        ; get and interpret file
  21.  
  22.     @0:    JSR    TextNormal-base(BP)    ; set font, mode and size
  23.     _ObscureCursor            ; hide the mouse cursor
  24.     JSR    NoCurs-base(BP)        ; erase the cursor
  25.     MOVE    (PS)+,D0        ; retrieve the key data
  26.     CMPI.B    #CR,D0            ; is the character a CR
  27.     BEQ.S    Interpret        ; if so: interpret the line
  28.     
  29.     CMPI.B    #BS,D0            ; is the character a backspace?
  30.     BNE.S    @1
  31.  
  32.     TST.B    Counter            ; rubout the previous character
  33.     BLE.S    @3            ; if count > 0 then
  34.  
  35.     SUBQ.B    #1,Counter         ;   decrement count
  36.     MOVE.B    #BL,0(IS,Counter)    ;   in buffer and ...
  37.     JSR    doDel-base(BP)
  38.     JSR    Space-base(BP)        ;   on terminal
  39.     JSR    doDel-base(BP)
  40.     BRA.S    @3
  41.     
  42.     @1:    CMPI.B    #80,Counter        ; is the buffer full
  43.     BEQ.S    @2            ; then just emit it
  44.  
  45.     MOVE.B    D0,0(IS,Counter.W)    ; stash the char into the buffer
  46.     ADDQ    #1,Counter        ; increment char count
  47.     @2:    JSR    EmitCode-base(BP)    ; emit the character    
  48.     @3: RTS
  49.  
  50. Interpret:    ; interpret a line of code
  51.     JSR    doCR-base(BP)        ; emit the CR
  52.     MOVE.B    #0,1(IS,Counter.W)    ; plant a null in the buffer
  53. Main:    JSR    token-Base(BP)        ; get the next word
  54.     MOVE    Dict,-(PS)        ; push pointer to last name
  55.     JSR    search-Base(BP)        ; find current token in dictionary
  56.     TST    (PS)+            ; found NOT IF,
  57.     BEQ.S    TestNum            ; ... assume its a number
  58.     BCLR    #7,fimmed-base(BP)    ; ELSE, immediate? IF
  59.     BNE.S    GoDo            ; ... do it
  60.     TST.B    fcolon-base(BP)        ; ELSE, compiling? NOT IF,
  61.     BEQ.S    GoDo            ; ... do it
  62.     BCLR    #7,fmacro-base(BP)    ; ELSE, macro? IF
  63.     BNE.S    domc
  64.     JSR    compile-base(BP)    ; ELSE, compile a JSR to it
  65.     BRA.S    Main
  66.   godo:    JSR    execute-base(BP)
  67.     JSR    StkChk-base(BP)
  68.     BRA.S    Main
  69.   domc:    JSR    mcomp-base(BP)
  70.     BRA.S    Main
  71.  
  72.   TestNum:
  73.     JSR    here-base(BP)        ; get the relative address of token
  74.     JSR    number-base(BP)        ; convert it to a value, if posible
  75.     TST    (PS)+            ;  was it?
  76.     BNE.S    @0            ; IF NOT,
  77.     BRA.S    Whazat            ;    say huh??? and EXIT
  78.     @0:    TST.B    fcolon-base(BP)        ; THEN, are you compiling?
  79.     BEQ.S    Main            ; IF NOT, leave it on the stack
  80.     JSR    literal-base(BP)    ; ELSE, compile it as a literal
  81.     BRA.S    Main            ; THEN, get on with it
  82.  
  83. ; ----- the dictionary ------
  84.  
  85. DictStart:
  86.     DCB.B    6,0            ; End of dictionary search
  87.     
  88.     DC.B    129,13,0,0        ; "{cr}" ( -- )
  89.     DC.W    DictStart-base
  90. CRet:    JSR    pasting-base(BP)    ; interpret from the scrap
  91.     TST.B    fint-base(BP)
  92.     BEQ.S    @0
  93.     MOVE.B    #0,0(IS,D5)        ; replace CR with null
  94.     @0:    BRA.S    Main
  95.     
  96.     DC.B    129,0,0,0        ; "{null}" ( -- )
  97.     DC.W    cret-theLink        ; interpret from the keyboard
  98. NRet:    JSR    clearTermBuf-base(BP)
  99.     CLR.L    Counter            ; clear input buffer offset
  100.     TST.B    fcolon-base(BP)
  101.     BNE.S    @0            ; don't issue prompt if compiling
  102.     JSR    prompt-base(BP)
  103.     @0:    JMP    kdone-base(BP)        ; jump back to the application
  104.  
  105.     DC.B    9,'?TE'            ; "?terminal" ( -- flag )
  106.     DC.W    nret-theLink        ;  is a key pressed?
  107. qTerm:    JMP    qtcode-base(BP)
  108.  
  109.     DC.B    3,'KEY'            ; "key" ( -- ascii )
  110.     DC.W    qterm-theLink        ;   wait for a key press
  111. Key:    JMP    keycode-base(BP)
  112.